home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / demos / 26 / pascal / prntsrc2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-06-19  |  29.5 KB  |  755 lines
  1. PROGRAM Print_Source;
  2. { This program prints the Pascal source code from the Personal Pascal }
  3. { Manager instead of going back to the Desk Top. Additional, you can  }
  4. { format a disk(single and double sided),delete,rename, and copy a file }
  5. { Written by Dan McKee, Compuserve - 75766,1515, Delphi - elmac }
  6. CONST
  7.         three = 3;
  8.         pattern = '.';
  9.         blank = ' ';
  10.         chunk_size = 4096;
  11.         fn_length = 64;
  12.         a_path = 'A:\';
  13.         b_path = 'B:\';
  14.  
  15. {$I GEMCONST.PAS}
  16.  
  17. TYPE
  18.  
  19.         buffer_type = PACKED ARRAY[1..chunk_size] OF byte;
  20.         file_name_type = packed array[1..80] of char;
  21. {$I GEMTYPE.PAS}
  22.  
  23. VAR
  24.    Path,fname : string;
  25.    msg : Message_Buffer;
  26.    menu : Menu_Ptr;
  27.    Author_Box,Print_Box,Help_Box,drive_box,format_box,rename_box,delete_box
  28.    ,copy_box,dos_box : Dialog_Ptr;
  29.    dummy,file_title,open_item,print_item,help_title,Author_Item,ok_button,
  30.    help_item, quit_item,sf,show_it,pushed,h_i,get_file,cancel_button,ss_btn,
  31.    ds_btn,f_i,d_i,A_btn,B_btn,format_btn,format_item,copy_item,delete_item,
  32.    rename_item,i,choice,r_i,e_i,c_i,ce_i,dos_item
  33.    : integer;
  34.    b : boolean;
  35.    buf : buffer_type;
  36.    in_file, out_file,p,nb : integer;
  37.    name : file_name_type;
  38.    filler : str255;
  39.  
  40. {$I GEMSUBS.PAS}
  41.  
  42.  
  43.  
  44. FUNCTION gem_create( VAR fname : file_name_type; mode : integer):integer;
  45. GEMDOS($3C);
  46.  
  47. FUNCTION gem_open( VAR fname : file_name_type;mode : integer) :integer;
  48. GEMDOS($3D);
  49.  
  50. PROCEDURE gem_close(handle : integer);
  51. GEMDOS($3E);
  52.  
  53. FUNCTION gem_read(handle : integer ; nbytes : long_integer;
  54.                   VAR buf : buffer_type) : long_integer;
  55. GEMDOS($3F);
  56.  
  57. FUNCTION gem_write(handle : integer ; nbytes : long_integer ;
  58.                   VAR buff : buffer_type): long_integer;
  59. GEMDOS($40);
  60.  
  61.  
  62.  
  63. PROCEDURE gem_seek(nbytes : long_integer;handle,mode : integer);
  64. GEMDOS($42);
  65.  
  66. FUNCTION Open_file( var name : path_name; mode : integer) : integer;
  67. GEMDOS($3D);
  68.  
  69. FUNCTION Delete_File(var name : file_name_type  ) : integer ;
  70. GEMDOS($41);
  71.  
  72. PROCEDURE Do_Format ; FORWARD;
  73.  
  74. PROCEDURE Format_Floppy(buffer,filler : long_integer;dev,spt,track,side,
  75.               interleave : integer;magic : long_integer;virgin : integer);
  76. XBIOS(10);
  77.  
  78. FUNCTION Boot_Sector(buff,serialno : long_integer;disktype,execflag :
  79.                      integer) : integer;
  80. XBIOS(18);
  81.  
  82. FUNCTION Write_Sector(buff,filler : long_integer;dev,sector,track,side,count :
  83.                       integer) : integer;
  84. XBIOS(9);
  85.  
  86. FUNCTION Rename_File(zero : integer ; var old_name,name :file_name_type)
  87.  : integer;
  88. GEMDOS($56);
  89.  
  90.  
  91. PROCEDURE Copy_Dialog;
  92.  
  93. BEGIN
  94.         sf := system_font;
  95.         copy_box := New_Dialog(5,0,0,30,11);
  96.         ce_i := Add_DItem(copy_box,G_FText,Editable,
  97.                         2,4,12,2,0,$1180);
  98.  
  99.         Set_DEdit(copy_box,ce_i,'________.___','aFFFFFFFFFF',''
  100.                   ,sf,TE_Left);
  101.         c_i := Add_DItem(copy_box,G_Text,None,2,1,13,1,0,$1180);
  102.         Set_DText(copy_box,c_i,'COPYING...',sf, TE_Center);
  103.         c_i := Add_DItem(copy_box,G_Text,None,2,3,15,1,0,$1180);
  104.         Set_DText(copy_box,c_i,fname,sf,TE_Center);
  105.         a_btn := Add_DItem(copy_box,G_Button,Selectable|Radio_Btn,
  106.                           2,6,8,1,1,$1180);
  107.         Set_DText(copy_box,a_btn,'A',sf,TE_Center);
  108.         b_btn := Add_DItem(copy_box,G_Button,Selectable|Radio_Btn,
  109.                           15,6,8,1,1,$1180);
  110.         Set_DText(copy_box,b_btn,'B',sf,TE_Center);
  111.         ok_button := Add_DItem(copy_box,G_Button,Selectable|Exit_Btn,
  112.                                2,8,8,2,2,$1180);
  113.         Set_DText(copy_box,ok_button,'OK',sf,TE_Center);
  114.         cancel_button := Add_DItem(copy_box,G_Button,Selectable|Exit_Btn
  115.                                ,15,8,8,2,2,$1180);
  116.         Set_DText(copy_box,cancel_button,'CANCEL',sf,TE_Center);
  117.         Obj_SetState(copy_box,a_btn,Selected,false);
  118.         Center_Dialog(copy_box);
  119.         show_it := Do_Dialog(copy_box,1);
  120.         Get_DEdit(copy_box,ce_i,filler);
  121.         End_Dialog(copy_box);
  122. END;{Copy_Dialog}
  123.  
  124. PROCEDURE D_Dialog( fname : string);
  125.  
  126. BEGIN
  127.         sf := System_Font;
  128.         delete_box := New_Dialog(4,0,0,30,10);
  129.         d_i := Add_DItem(delete_box,G_Text,None,2,1,12,1,0,$1180);
  130.         Set_DText(delete_box,d_i,'DELETE FILE',sf,TE_Center);
  131.         d_i := Add_DItem(delete_box,G_Text,None,2,3,15,1,0,$1180);
  132.         Set_Dtext(delete_box,d_i,fname,sf,TE_Center);
  133.         ok_button := Add_DItem(delete_box,G_Button,Selectable|Exit_Btn,
  134.                      2,7,8,2,2,$1180);
  135.         Set_DText(delete_box,ok_button,'OK',sf,TE_Center);
  136.         cancel_button := Add_DItem(delete_box,G_Button,Selectable|Exit_Btn,
  137.                      15,7,8,2,2,$1180);
  138.         Set_Dtext(delete_box,cancel_button,'CANCEL',sf,TE_Center);
  139.         Center_Dialog(delete_box);
  140.         show_it := Do_Dialog(delete_box,0);
  141.         End_Dialog(delete_box);
  142. END; {Delete_Dialog}
  143.  
  144. PROCEDURE Rename_Dialog( var name : str255);
  145.  
  146. BEGIN
  147.         sf := System_Font;
  148.         rename_box := New_Dialog(4,0,0,30,10);
  149.         e_i := Add_DItem(rename_box,G_FText,Editable,
  150.                2,4,12,2,0,$1180);
  151.         Set_DEdit(rename_box,e_i,'________.___','aFFFFFFFFFF',name,
  152.         sf,TE_Left);
  153.         r_i := Add_DItem(rename_box,G_Text,None,2,1,13,1,0,$1180);
  154.         Set_DText(rename_box,r_i,'RENAME FILE',sf,TE_Left);
  155.         ok_button := Add_DItem(rename_box,G_Button,Selectable|Exit_Btn,
  156.                      2,7,8,2,2,$1180);
  157.         Set_DText(rename_box,ok_button,'OK',sf,TE_Center);
  158.         cancel_button := Add_DItem(rename_box,G_Button,Selectable|Exit_Btn,
  159.                          15,7,8,2,2,$1180);
  160.         Set_DText(rename_box,cancel_button,'CANCEL',sf,TE_Center);
  161.         Center_Dialog(rename_box);
  162.         show_it := Do_Dialog(rename_box,1);
  163.         Get_DEdit(rename_box,e_i,name);
  164.  
  165.         End_Dialog(rename_box);
  166. END; { Rename_Dialog }
  167.  
  168. { Dialog box for printing a file or cancel printing }
  169. PROCEDURE Print_Info;
  170.  
  171. BEGIN
  172.         sf := System_Font;
  173.         Print_Box := New_Dialog(15,0,0,40,9);
  174.         Print_Item := Add_DItem(Print_Box,G_Text,None,2,1,36,1,0,$1180);
  175.         Set_DText(Print_Box,Print_Item,'Printing....',sf,TE_Center);
  176.         Print_Item := Add_DItem(Print_Box,G_Text,None,2,3,36,1,0,$1180);
  177.         SET_DText(Print_Box,Print_Item,Name,sf,TE_Center);
  178.         ok_button := Add_DItem(Print_Box,G_Button,Selectable|Exit_Btn|Default,
  179.                   5,5,8,2,2,$1180);
  180.         Set_DText(Print_Box,ok_button,'OK',sf,TE_Center);
  181.         cancel_button := Add_DItem(Print_Box,G_Button,Selectable|Exit_Btn,
  182.                          27,5,8,2,2,$1180);
  183.         Set_DText(Print_Box,cancel_button,'Cancel',sf,TE_Center);
  184.         Center_Dialog(Print_Box);
  185.         Show_It := Do_Dialog(Print_Box,0);
  186.  
  187. END; {Print_Info}
  188.  
  189. { dialog box for displaying the programmer and giving credits }
  190.  
  191. PROCEDURE Author_Info;
  192.  
  193. BEGIN
  194.         sf := System_Font;
  195.         Author_Box := New_Dialog(15,0,0,40,18);
  196.         Author_Item := Add_DItem(Author_Box,G_Text,None,2,1,36,1,0,$1180);
  197.         Set_DText(Author_Box,Author_Item,'Print Source',sf,TE_Center);
  198.         Author_item := Add_DItem(Author_Box,G_Text,None,2,2,36,1,0,$1180);
  199.         Set_DText(Author_Box,Author_Item,'By',sf,TE_Center);
  200.         Author_item := Add_DItem(Author_Box,G_Text,None,2,3,36,1,0,$1180);
  201.         Set_DText(Author_Box,Author_Item,'Daniel H. McKee',sf,TE_Center);
  202.         Author_item := Add_DItem(Author_Box,G_Text,None,2,5,36,1,0,$1180);
  203.         Set_DText(Author_Box,Author_Item,'Compuserve - PPN 75766,1515',
  204.                   sf,TE_Center);
  205.         Author_item := Add_DItem(Author_Box,G_Text,None,2,6,36,1,0,$1180);
  206.         Set_DText(Author_Box,Author_Item,'Delphi - elmac',sf,TE_Center);
  207.         Author_item := Add_DItem(Author_Box,G_Text,None,2,8,36,1,0,$1180);
  208.         Set_DText(Author_Box,Author_Item,'Using',sf,TE_Center);
  209.         Author_item := Add_DItem(Author_Box,G_Text,None,2,10,36,1,0,$1180);
  210.         Set_DText(Author_Box,Author_Item,'Personal Pascal',sf,TE_Center);
  211.         Author_item := Add_DItem(Author_Box,G_Text,None,2,11,36,1,0,$1180);
  212.         Set_DText(Author_Box,Author_Item,'Copyright (c) 1986 OSS & CCD',
  213.                   sf,TE_Center);
  214.         ok_button := Add_DItem(Author_Box,G_Button,Selectable|Exit_Btn|Default,
  215.                   15,15,8,2,2,$1180);
  216.         Set_DText(Author_Box,ok_button,'OK',sf,TE_Center);
  217.         Center_Dialog(Author_Box);
  218.         Show_It := Do_Dialog(Author_Box,0);
  219.         End_Dialog(Author_Box);
  220.  
  221. END;{Author_Info}
  222.  
  223. { dialog box for program instructions }
  224.  
  225. PROCEDURE Do_Help;
  226.  
  227. BEGIN
  228.         sf := System_Font;
  229.         Help_Box := New_Dialog(15,0,0,72,14);
  230.         h_i := Add_DItem(Help_Box,G_Text,None,2,2,68,1,0,$1180);
  231.         Set_DText(Help_Box,h_i,
  232.         ' This program is design to print the scorce code from Personal',
  233.         sf,TE_Left);
  234.         h_i := Add_DItem(Help_Box,G_Text,None,2,3,68,1,0,$1180);
  235.         Set_DText(Help_Box,h_i,
  236.         ' Pascal Manager, but can be run from the Gem Desk Top if desired. ',
  237.         sf,TE_Left);
  238.         h_i := Add_DItem(Help_Box,G_Text,None,2,4,68,1,0,$1180);
  239.         Set_DText(Help_Box,h_i,
  240.         ' To print out your desired code, move the mouse to the menu bar',
  241.         sf,TE_Left);
  242.         h_i := Add_DItem(Help_Box,G_Text,None,2,5,68,1,0,$1180);
  243.         Set_DText(Help_Box,h_i,
  244.         ' "File" and click on the "Open File" option. The program is self-',
  245.         sf,TE_Left);
  246.         h_i := Add_DItem(Help_Box,G_Text,None,2,6,68,1,0,$1180);
  247.         Set_DText(Help_Box,h_i,
  248.         ' explanatory from this point. If you have a second disk or ram disk,',
  249.         sf,TE_Left);
  250.         h_i := Add_DItem(Help_Box,G_Text,None,2,7,68,1,0,$1180);
  251.         Set_DText(Help_Box,h_i,
  252.         ' you can change the default drive by pointing the mouse to the ',
  253.         sf,TE_Left);
  254.         h_i := Add_DItem(Help_Box,G_Text,None,2,8,68,1,0,$1180);
  255.         Set_DText(Help_Box,h_i,
  256.         ' Directory, click the mouse, backspace, type in desired path, and',
  257.         sf,TE_Left);
  258.         h_i := Add_DItem(Help_Box,G_Text,None,2,9,68,1,0,$1180);
  259.         Set_DText(Help_Box,h_i,
  260.         ' then move the mouse to the filenames, then click the mouse. Enjoy!',
  261.         sf,TE_Left);
  262.         ok_button := Add_DItem(Help_Box,G_Button,Selectable|Exit_Btn|Default,
  263.                   30,11,8,2,2,$1180);
  264.         Set_DText(Help_Box,ok_button,'OK',sf,TE_Center);
  265.         Center_Dialog(Help_Box);
  266.         show_it := Do_Dialog(Help_Box,0);
  267.         End_Dialog(Help_Box);
  268.  
  269. END; {Do_Help}
  270.  
  271. PROCEDURE Dos_Help;
  272.  
  273. BEGIN
  274.         sf := System_Font;
  275.         dos_box := New_Dialog(6,0,0,64,14);
  276.         d_i := Add_DItem(dos_box,G_Text,none,2,1,14,1,0,$1180);
  277.         Set_Dtext(dos_box,d_i,'FILE OPTIONS',sf,TE_Center);
  278.         d_i := Add_DItem(dos_box,G_Text,none,2,3,60,1,0,$1180);
  279.         Set_DText(dos_box,d_i,
  280.         'FORMAT - Select a drive, then select single or double sided.',sf,
  281.         TE_Left);
  282.         d_i := Add_DItem(dos_box,G_Text,none,2,5,60,1,0,$1180);
  283.         Set_DText(dos_box,d_i,
  284.         'DELETE - Select a file for deleting.',sf,TE_Left);
  285.         d_i := Add_DItem(dos_box,G_Text,none,2,7,60,1,0,$1180);
  286.         Set_DText(dos_box,d_i,
  287.         'RENAME - Select file, then select a drive for renaming.',sf,TE_Left);
  288.         d_i := Add_DItem(dos_box,G_Text,none,2,9,60,1,0,$1180);
  289.         Set_DText(dos_box,d_i,
  290.         'COPY - Select file, then select a drive for copying.',sf,TE_Left);
  291.         ok_button := Add_DItem(dos_box,G_Button,Selectable|Exit_Btn,
  292.                      25,11,8,2,2,$1180);
  293.         Set_DText(dos_box,ok_button,'OK',sf,TE_Center);
  294.         Center_Dialog(dos_box);
  295.         show_it := Do_Dialog(dos_box,0);
  296.         End_Dialog(dos_box);
  297. END;{ Dos_Help }
  298.  
  299.  
  300.  
  301.  
  302.  
  303. PROCEDURE Format_Dialog;
  304.  
  305. BEGIN
  306.         sf := System_Font;
  307.         format_box := New_Dialog(5,0,0,35,9);
  308.         f_i := Add_DItem(format_box,G_Text,none,2,1,14,1,0,$1180);
  309.         Set_DText(format_box,f_i,'FORMAT OPTIONS',sf,TE_Center);
  310.         ss_btn := Add_DItem(format_box,G_Button,Selectable|Radio_Btn
  311.                             ,2,3,14,1,1,$1180);
  312.         Set_DText(format_box,ss_btn,'Single-Sided',sf,TE_Center);
  313.         ds_btn := Add_DItem(format_box,G_Button,Selectable|Radio_Btn
  314.                             ,19,3,14,1,1,$1180);
  315.         Set_DText(format_box,ds_btn,'Double-Sided',sf,TE_Center);
  316.         format_btn := Add_DItem(format_box,G_Button,Selectable|Exit_Btn,
  317.                       2,5,8,2,2,$1180);
  318.         Set_DText(format_box,format_btn,'Format',sf,TE_Center);
  319.         cancel_button := Add_DItem(format_box,G_Button,Selectable|Exit_Btn,
  320.                                 19,5,8,2,2,$1180);
  321.         Set_DText(format_box,cancel_button,'cancel',sf,TE_Center);
  322.         Obj_SetState(format_box,ss_btn,Selected,false);
  323.         Center_Dialog(format_box);
  324.         show_it := Do_Dialog(format_box,0);
  325.         IF Obj_State(format_box,format_btn) <> 0 THEN
  326.  
  327.            Do_format
  328.         ELSE
  329.         End_Dialog(format_box);
  330. END; { Format_Dialog_Box }
  331.  
  332. PROCEDURE Drive_Dialog;
  333.  
  334. BEGIN
  335.         sf := System_Font;
  336.         drive_box := New_Dialog(5,0,0,30,9);
  337.         d_i := Add_DItem(drive_box,G_Text,None,2,1,18,1,0,$1180);
  338.         Set_DText(drive_box,d_i,'FORMAT WHICH DRIVE?',sf,TE_Center);
  339.         A_btn := Add_DItem(drive_box,G_button,Selectable|Radio_Btn
  340.                            ,2,3,8,1,1,$1180);
  341.         Set_DText(drive_box,A_btn,'A',sf,TE_Center);
  342.         B_btn := Add_DItem(drive_box,G_button,Selectable|Radio_Btn
  343.                            ,15,3,8,1,1,$1180);
  344.         Set_DText(drive_box,B_btn,'B',sf,TE_Center);
  345.         ok_button := Add_DItem(drive_box,G_button,Selectable|Exit_Btn,
  346.                       2,5,8,2,2,$1180);
  347.         Set_DText(drive_box,ok_button,'OK',sf,TE_Center);
  348.         cancel_button := Add_DItem(drive_box,G_button,Selectable|Exit_Btn,
  349.                       15,5,8,2,2,$1180);
  350.         Set_DText(drive_box,cancel_buttton,'CANCEL',sf,TE_Center);
  351.         Obj_SetState(drive_box,A_btn,Selected,false);
  352.         Center_Dialog(drive_box);
  353.         show_it := Do_Dialog(drive_box,0);
  354.         End_Dialog(drive_box);
  355.         IF Obj_State(drive_box,ok_button) <> 0 THEN
  356.            Format_Dialog
  357.         ELSE;
  358. END; { Drive_Dialog }
  359.  
  360. PROCEDURE Do_Format;
  361.  
  362. VAR
  363.         track,side,virgin,buff,disktype,execflag,spt,w,b,zero,sector,
  364.         count,dev,interleave : integer;
  365.         buffer,magic,serialno,filler : long_integer;
  366.  
  367. BEGIN
  368.         BEGIN
  369.                 track := 0;
  370.                 side := 0;
  371.                 buff := 1024;
  372.                 disktype := 2;
  373.                 execflag := 1;
  374.                 spt := 9;
  375.                 zero := $00;
  376.                 sector := 1;
  377.                 count := 1;
  378.                 interleave := 1;
  379.                 buffer := $3000;
  380.                 magic := $87654321;
  381.                 serialno := -1;
  382.         END;
  383.  
  384.         BEGIN
  385.                 virgin := zero;
  386.                 IF Obj_State(drive_box,ds_btn) <> 0 THEN
  387.                    dev := 1
  388.                 ELSE dev := 0;
  389.                 REPEAT
  390.                         Format_Floppy(buffer,filler,dev,spt,track,side,
  391.                         interleave,magic,virgin);
  392.                         IF Obj_State(format_box,ds_btn) <> 0 THEN
  393.                         BEGIN
  394.                              virgin := $E5E5;
  395.                              side := 1;
  396.                              Format_Floppy(buffer,filler,dev,spt,track,side,
  397.                              interleave,magic,virgin);
  398.                              side := 0;
  399.                              IF track < 2 THEN
  400.                                 virgin := zero;
  401.                         END;
  402.                         track := track + 1;
  403.  
  404.                         IF track = 2 THEN
  405.                            virgin := $E5E5;
  406.                 UNTIL track = 80;
  407.                 b := Boot_Sector(buff,serialno,disktype,execflag);
  408.                 track := 0;
  409.                 w := Write_Sector(buff,filler,dev,sector,track,side,count);
  410.                 End_Dialog(format_box);
  411.                 rewrite(output,'con:');
  412.         END;
  413. END; { Do_Format }
  414.  
  415. PROCEDURE Error_Check;
  416.      BEGIN
  417.         CASE i OF
  418.  
  419.         -13  : choice := Do_Alert('[1][disk is write protected[ ok ]',0);
  420.         -33  : choice := Do_Alert('[1][file not found][ ok ]',0);
  421.  
  422.         END;
  423.      END; { Error_check }
  424.  
  425. { to print or not to print! }
  426.  
  427. PROCEDURE Print_It;
  428.           BEGIN
  429.                { get the dialog box }
  430.  
  431.                Print_Info;
  432.                { check to see if the ok_button was selected }
  433.                IF Obj_State(Print_Box,ok_button) <> 0 THEN
  434.                  BEGIN
  435.                      IO_Check(b);
  436.                { set the default input from the keyboard to the disk }
  437.                      reset( INPUT, fName );
  438.                      i := IO_Result;
  439.                      Error_Check;
  440.                      IF i <> -33 THEN
  441.                        BEGIN
  442.                { set the default output from the screen to the printer }
  443.                            REWRITE(OUTPUT,'PRN:');
  444.                { loop for print the file until the end-of-file character }
  445.                            WHILE NOT EOF DO
  446.                                           BEGIN
  447.  
  448.                                               readln(fName);
  449.                                               WRITELN(fNAME);
  450.                                           END;
  451.                                           End_Dialog(Print_Box);
  452.                        END;
  453.                        End_Dialog(print_box);
  454.                  END;
  455.                { check to see if the cancel_button was selected }
  456.                IF Obj_state(Print_Box,cancel_button) <> 0 THEN
  457.                 End_Dialog(Print_Box);
  458.  
  459.           END; { Print_It }
  460.  
  461. { this module set the path directory with the extender of '.PAS' }
  462.  
  463. PROCEDURE Draw_It;
  464.             BEGIN
  465.                  { set a default path }
  466.                  Path := 'A:\*.PAS';
  467.                  { Draw predefined dialog box for listing source files }
  468.                   IF Get_In_File(Path,fName) THEN
  469.                         Print_It
  470.                   { cancel button pressed, erase dialog box }
  471.                   ELSE ;
  472.              END; { Draw_It }
  473.  
  474. PROCEDURE Do_Delete;
  475.  
  476. var
  477.         fname : string;
  478.         infile,i : integer;
  479.         name : file_name_type;
  480.  
  481. BEGIN
  482.           IF Get_In_File(path,fname) THEN
  483.              BEGIN
  484.                   D_Dialog(fname);
  485.                   IF Obj_State(delete_box,ok_button) <> 0 THEN
  486.                   BEGIN
  487.                         FOR i := 1 TO length(fname) DO
  488.                         name[i] := fname[i];
  489.                         name[length(fname) + 1] := chr(0);
  490.                         infile := Delete_File(name);
  491.  
  492.                  END;
  493.              END;
  494. END; { Do_Delete }
  495.  
  496. PROCEDURE copy_file(in_file, out_file : integer);
  497.  
  498. VAR
  499.         n : long_integer;
  500. BEGIN
  501.         REPEAT
  502.                 gem_close(out_file);
  503.                 out_file := gem_open(name,1);
  504.  
  505.                 gem_seek(0,out_file,2);
  506.                 n := gem_read(in_file,chunk_size,buf);
  507.                 {writeln('reading chunk of ',n,' on input file');}
  508.                 if n < 0 then
  509.                         begin
  510.                                 writeln('error ',n,' on iput file');
  511.                                 halt;
  512.                         end
  513.                 else if n > 0 then
  514.                         if gem_write(out_file,n,buf ) = n then
  515.                                { writeln('wrote chunk properly')  }
  516.                         else
  517.                                 begin
  518.                                         writeln('error writing output file');
  519.                                         halt;
  520.                                 end;
  521.         UNTIL n = 0;
  522. END;
  523.  
  524. PROCEDURE Do_Copy;
  525.  
  526. var
  527.         i : integer;
  528. BEGIN
  529.         IF Get_In_File(path,fname) THEN
  530.         BEGIN
  531.         for i := 1 to length(fname) do
  532.         name[i] := fname[i];
  533.         name[length(fname) + 1] := chr(0);
  534.  
  535.         in_file := gem_open(name,0);
  536.         copy_dialog;
  537.         if Obj_State(copy_box,ok_button) <> 0 THEN
  538.          BEGIN
  539.         fname := filler;
  540.          BEGIN
  541.                 i := length(fname);
  542.                 if i >8 then
  543.                         begin
  544.                                 p := pos(blank,fname);
  545.                                 if (p > 9) or (p = 0) then
  546.                                 insert(pattern,fname,9);
  547.                                 if p <> 0 then
  548.                                         begin
  549.                                                 insert(pattern,fname,p);
  550.                                                 begin
  551.                                                         p := pos(blank,fname);
  552.                                                         nb := p;
  553.                                                         repeat
  554.                                                         p := pos(blank,fname);
  555.                                                         delete(fname,p,1);
  556.                                                         nb := nb + 1;
  557.                                                         until nb = 10;
  558.                                                 end;
  559.                                         end;
  560.                         end;
  561.          END;
  562.  
  563.         IF Obj_State(copy_box,a_btn) <> 0 THEN
  564.                 insert(a_path,fname,1)
  565.         ELSE insert(b_path,fname,1);
  566.         for i := 1 to length(fname) do
  567.         name[i] := fname[i];
  568.         name[length(fname) + 1] := chr(0);
  569.         out_file := gem_create(name,0);
  570.         copy_file(in_file,out_file);
  571.         gem_close(in_file);
  572.         gem_close(out_file);
  573.         END;
  574.         END;
  575.  
  576. END; { Do_Copy }
  577.  
  578. PROCEDURE Do_Rename;
  579.  
  580. {this procedure is design generally to rename a file. However, I went }
  581. { a little farther to edit the file name in the dialog box so the output}
  582. { would look somewhat like in the desktop                               }
  583.  
  584. const
  585.         blank = ' ';
  586.         pattern = '.';
  587.  
  588. var
  589.         fname : str255;
  590.         temp,temp_name : string;
  591.         zero,p,start,result,count,i,nb,rename_it : integer;
  592.         name,old_name : file_name_type;
  593. BEGIN
  594.         zero := 0;
  595.         if Get_in_file(path,fname) then
  596.         BEGIN
  597.  
  598.                 {put the actual file name in a temporary variable}
  599.                 temp_name := fname;
  600.                 {copy the path}
  601.                 temp := copy(fname,1,3);
  602.                 {delete the path so it is not shown on the dialog box}
  603.                 Delete(fname,1,3);
  604.                 {check the length of the file, if it is 8 or less, no need}
  605.                 { to edit the file name}
  606.                 i := length(fname);
  607.                 if i > 8 then
  608.                         begin
  609.  
  610.                               { find the pos of the period}
  611.                               p := pos(pattern,fname);
  612.                               { the period isn't is position 9? then we have}
  613.                               { to insert some blanks so the output looks good}
  614.                               { number 9 is the position where it separates }
  615.                               { first eight characters of the file name and }
  616.                               { three character extender }
  617.                               if p < 9 then
  618.                                     begin
  619.                                          { calculation to find how many blanks}
  620.                                          { to be inserted }
  621.                                          result := 9 - p;
  622.                                          { position to insert the blanks }
  623.                                          start :=  p ;
  624.                                          { counter }
  625.                                          count := 0;
  626.                                          { insert the blank(s)! }
  627.                                          repeat
  628.                                                insert(blank,fname,start);
  629.                                                count := count + 1;
  630.                                          until count = result ;
  631.                                         { find the period again }
  632.                                          p := pos(pattern,fname);
  633.                                     end;
  634.                               { delete the period, why? the dialog box already}
  635.                               { has a period on the editing line }
  636.                               delete(fname,p,1);
  637.                         end;
  638.         { pass the file name to the dialog box procedure for editing }
  639.         Rename_Dialog(fname);
  640.         { check to see if the ok button was selected, if selected, lets take }
  641.         { out the blanks }
  642.         IF Obj_State(rename_box,ok_button) <> 0 THEN
  643.         BEGIN
  644.         { check the length again, if the file didn't have an extender, no }
  645.         { reason to take out any blanks }
  646.         i := length(fname);
  647.         if i > 8 then
  648.                 begin
  649.                      p := pos(blank,fname);
  650.                      { check to see if the blanks occured after the file name }
  651.                      { if true, the file name had eight characters before the }
  652.                      { extender and at least one character extender, so the }
  653.                      { the period get inserted a the nineth position }
  654.                      iF (p > 9) or (p = 0) then insert(pattern,fname,9);
  655.                      { blank occurs before the nineth position, take out the }
  656.                      { blank(s)! }
  657.                      if p<>0 then
  658.  
  659.                         begin
  660.                                 { insert a period at the first occurancy of a }
  661.                                 { blank, this is the correct position }
  662.                                 insert(pattern,fname,p);
  663.                                         begin
  664.                                                 { find the blank }
  665.                                                 p:= pos(blank,fname);
  666.                                                 nb := p;
  667.                                                 { repeat the process until }
  668.                                                 { all the blanks are deleted }
  669.                                                 repeat
  670.                                                         p:=pos(blank,fname);
  671.                                                         delete(fname,p,1);
  672.                                                         nb := nb + 1;
  673.                                                 until nb = 10;
  674.                                         end;
  675.                         end;
  676.                 end;
  677.                 { insert the path back into the file name }
  678.                 insert(temp,fname,1);
  679.                 { thanks to OSS for this routine! }
  680.                 BEGIN
  681.                         FOR i := 1 TO length(fname) DO
  682.                         name[i] := fname[i];
  683.                         { add zero to the end, 'C' needs it }
  684.                         name[length(fname) + 1] := chr(0);
  685.                 END;
  686.  
  687.                 BEGIN
  688.  
  689.                         FOR i := 1 TO length(temp_name) DO
  690.                         old_name[i] := temp_name[i];
  691.                         old_name[length(temp_name) + 1] := chr(0);
  692.                 END;
  693.                 {all finished, take old name and new name to renaming function}
  694.                 rename_it := Rename_File(zero,old_name,name);
  695.  
  696.         END;
  697.         END;
  698. END; { Do_Rename, Whew!!! }
  699.  
  700.  
  701.  { this module checks the menu bar for the option selected }
  702.  
  703.     PROCEDURE Do_menu(title,item : integer);
  704.  
  705.  BEGIN
  706.        BEGIN
  707.          IF title = three THEN
  708.                               Author_Info
  709.          ELSE IF item = open_item THEN
  710.                               Draw_it
  711.          ELSE IF item = help_item THEN
  712.                               Do_Help
  713.          ELSE IF item = dos_item THEN
  714.                               Dos_Help
  715.          ELSE IF item = format_item THEN
  716.                               Drive_Dialog
  717.          ELSE IF item = delete_item THEN
  718.                               Do_Delete
  719.  
  720.          ELSE IF item = rename_item THEN
  721.                               Do_Rename
  722.          ELSE IF item = copy_item THEN
  723.                               Do_Copy
  724.          ELSE IF item = quit_item THEN
  725.        END;
  726.        Menu_Normal(menu,title);
  727.  END; { Do_Menu }
  728.  
  729. { loop for getting a message }
  730.  
  731. PROCEDURE Event_Loop;
  732.    VAR
  733.       which : integer;
  734.       msg : Message_Buffer;
  735.  
  736.    BEGIN
  737.         REPEAT
  738.  
  739.               which := Get_Event(E_Message,0,0,0,0,false,0,0,0,0,false,
  740.                                  0,0,0,0,msg,dummy,dummy,dummy,dummy,
  741.                                  dummy,dummy);
  742.               Do_Menu( Msg[3], Msg[4]);
  743.               UNTIL msg[4] = quit_item;
  744.    END; { Event_Loop }
  745.  
  746. PROCEDURE New_Menu_Bar;
  747.  
  748.   BEGIN
  749.             menu := New_Menu( 6, ' file printer ' );
  750.             file_title := Add_MTitle( menu, ' File ' );
  751.             Help_title := Add_MTitle( menu, ' Help ' );
  752.             open_item := Add_MItem ( menu, file_title, ' Print File ' );
  753.             help_item := Add_MItem ( menu, help_title, ' Print Info ');
  754.             dos_item  := Add_MItem ( menu, help_title, ' File Info  ');
  755.             format_item := Add_MItem(menu,file_title,  ' Format     ');
  756.             delete_item := Add_MItem( menu, file_title,' Delete     ');
  757.             rename_item := Add_MItem( menu, file_title,' Rename     ');
  758.             copy_item := Add_MItem( menu, file_title,  ' Copy       ');
  759.             quit_item := Add_MItem ( menu, file_title, ' Quit       ');
  760.             Draw_Menu( menu );
  761.   END;
  762.  
  763. BEGIN { Main Program }
  764.     IF Init_Gem >= 0 THEN
  765.        BEGIN
  766.             Init_Mouse;
  767.             path := 'A:\.PAS';
  768.             New_Menu_Bar;
  769.             Event_Loop;
  770.             Erase_Menu ( menu);
  771.             Exit_Gem;
  772.        END
  773.  
  774. END. { Main }
  775.